perm filename JSX[NEW,LCS] blob
sn#701991 filedate 1983-03-10 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C 2/18/83 ******** SUBROUTINE JUSTFY, FUNCTION OTHSID *************
C00024 ENDMK
Cā;
C 2/18/83 ******** SUBROUTINE JUSTFY, FUNCTION OTHSID *************
SUBROUTINE JUSTFY(JLP,ITEM,NPW,NO,RN,RSTFAC,R2,R4,R5)
CX SUBROUTINE JUSTFY(JLP,R,IR,NO,NP,RN,RSTFAC,R2,R4,R5,R6,R8,R9)
COPYRIGHT 1983 BY LELAND SMITH
COMMON/RINP/XPS(900),XPR(300)
COMMON /JST/ N,XP(300),XPL(300)
DIMENSION RN(1),NO(1),RSTFAC(0/1),NPW(1)
C JLP= TOP STAFF NUM.
C R2=THIS STAFF NUM. R4=LEFT EDGE, R5=RIGHT EDGE.
RJLP=JLP
N=1
DO 200 K=1,ITEM
L=NPW(K)
RL=RN(L)
C RL=WDCNT-2
RA=RN(L+1)
C RA=CODE NUM.
RR3=RN(L+3)
C RR3=POSITION(P3)
IF(RR3+0.1.LT.R4.OR.RR3.GT.R5)GO TO 200
C JUMP IF ITEM NOT IN BOUNDS
IF(RA.GT.4.0.AND.RA.LT.17.0)GO TO 200
C LOOKS AT NOTES, RESTS, CLEFS, BARS, KSIG, METER
RR2=RN(L+2)
C RR2=STAFF NUM. OF THIS ITEM
IF(RR2.NE.R2.AND.R2.LE.RJLP)GO TO 200
C THIS STAFF? OR LOOK AT ALL STAVES.
RY=1.
C BASIC SIZE FACTOR
PL=0
RR5=RN(L+5)
C RR5=PARAM 5 RR6=P6 RW=P4
RR6=RN(L+6)
78 RR4=RN(L+4)
C RR4=HEIGHT-MINI(P4)
M=RA
GO TO(1,2,3,4)M
C LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
IF(M.EQ.18)GO TO 18
GO TO 17
C***** NOTES ******
1 IF(RL.GE.7.0.AND.RN(L+9).LT.0)GO TO 200
C IF P9<0 IGNORE THIS NOTE.
RR7=RN(L+7)
C RR7=P7 DOTS, TAILS
RC=ABS(RR4)
RR4=AMOD(RR4,100.0)
IF(RR4.GT.80.0)RR4=RR4-100.0
IF(RC.LT.80.)GO TO 19
IF(RC.LT.180.)RY=.6
C FOUND A MINI-NOTE
CC19 PL=1.
C SPACE NEEDED TO LEFT
19 PR=3.5
C SPACE NEEDED TO RIGHT
PRR=0
C STORES EXTRA SPACE TO RIGHT
PLL=0
C STORES EXTRA SPACE TO LFT
CX IF(RR4.LT.13.0.AND.RR4.GT.1.0)GO TO 10
C IF LEDGER LINES ADD SPACE ON BOTH SIDES.
CX PR=4.0
CX PL=1.0
10 IF(RR7.EQ.0)GO TO 12
C TAIL ON NOTE? (CHECK FOR HALF, WHOLE NOTES, RR6<0)
RR=AMOD(RR7,10.0)
IF(RR.LE.0.OR.RR6.LT.0)GO TO 11
IF(RR5.LT.10.0.OR.RR5.GE.20.0)GO TO 11
C SKIP IF NO STEM OR STEM DOWN
PRR=1.5
C ADD ROOM FOR TAIL
11 KK=RR7/10
CC PX=2*KK
PX=1.6*KK
C SPACE FOR DOT(S)
PX=PX+AMOD(RR7,1.0)*10.0
C ADD SOME IF DOTS SPACED EXTRA TO RIGHT (E.G. 1.23=2.3 SPACES TO RT.)
IF(PX.GT.PRR)PRR=PX
IF(RR7.GE.10.0)GO TO 1012
C NOTE HAS DOT, NO SPACE NEEDED FOR LEDGER LINE.
IF(RR5.GE.10.0.AND.RR5.LT.20.0.AND.AMOD(RR7,10.0).GE.1.0)
1 GO TO 1012
C SKIP IF NOTE HAS TAIL ON STEM UP.
12 IF(PRR.GT.1.5)GO TO 1012
C ALREADY ENOUGH SPACE FOR LEDGER LINE EXTENSION - SKIP NEXT
JJ=0
C NOW FIND NEXT CLOSEST NOTE TO RIGHT ON THIS STAFF.
Z=10.0
X=RR4-13.0
DO 1000 M=1,ITEM
J=NPW(M)
IF(RN(J+1).NE.1.0)GO TO 1000
C LOOK AT NOTES ONLY
IF(RN(J+2).NE.RR2)GO TO 1000
C THIS STAFF ONLY
Y=RN(J+3)-RR3
IF(Y.LE.0.OR.Y.GT.Z)GO TO 1000
Z=Y
JJ=J
1000 CONTINUE
IF(Z.GE.10.0)GO TO 1012
IF(AMOD(RN(JJ+5),10.0).GE.1.0)GO TO 1012
C SKIP IF NEXT NOTE HAS ACCI. IN FRONT.
Z=AMOD(RN(JJ+4),100.0)
C GET HEIGHT OF NOTE
IF(X.GE.0)GO TO 1001
C SKIP IF 1ST NOTE IS ABOVE STAFF
IF(Z.GE.1.0)GO TO 1002
GO TO 1012
1001 IF(Z.LT.13.0)GO TO 1012
C SKIP IF NEXT NOTE BELOW STAFF
1002 PRR=1.5
C ADD 1. SO LEDGER LINES DON'T BUMP
1012 RR=AMOD(RR5,10.0)
C ANY ACCIDENTALS?
IF(RR.EQ.0)GO TO 13
PLL=3.0
IF(IFIX(RR).EQ.4)PLL=5.0
C RR=4 = DOUBLE FLAT
PLL=PLL+AMOD(RR5,1.0)*10.0
C INCREASE IF ACCI. SPACED TO LEFT. (E.G. 12.21 =2.1 SPACES TO LEFT)
13 IF(RR6.EQ.0)GO TO 14
C LOOK FOR HALF NOTES, WHOLE NOTES, NOTES ON WRONG SIDE OF STEM.
KK=0
IF(RR6.GT.0)GO TO 130
C NOW IT'S A WHITE NOTE
PR=3.9
C 3.9=MINIMUM SPACE FOR HALFNOTE
KK=IFIX(AMOD(RR7,10.0))
C GET RT. DIGIT IN P7
IF(KK.EQ.1)PR=4.3
IF(KK.EQ.2)PR=4.8
C =1=WHOLENOTE, =2=DOUBLE WHOLENOTE
IF(RR6.GT.-10.0)GO TO 14
C NOW NOTE ON WRONG SIDE OF STEM
130 AR=2.5
IF(KK.EQ.1)AR=3.0
IF(KK.EQ.2)AR=3.5
IF(ABS(RR6).GE.20.0)GO TO 135
C NOW NOTE TO RIGHT OF STEM
PRR=PRR+AR
GO TO 14
135 PLL=PLL+AR
C ADD SPACE TO LEFT IF NOTE ON LEFT SIDE OF STEM
14 PR=(PR+PRR)*RY
PL=(PL+PLL)*RY
IF(RL.LT.8)GO TO 700
C JUMP IF THERE IS NOT P10 TO LOOK AT
RR2=RR2+1
CC RW=RN(L+10)
C PUT P10 INTO RW
IF(RN(L+10).GE.2.0)RR2=RR2-2.
C NOW STAFF # IS SET TO WHERE NOTE REALLY IS.
GO TO 700
C***** RESTS *****
2 IF(RL.GE.4.0.AND.RR6.LT.0)GO TO 200
IF(RL.GE.5.0.AND.RR7.LT.0)GO TO 200
C SKIP INVISIBILE RESTS AND RESTS WITH NEG. RHY.
IF(RL.GE.6.0.AND.RR8.NE.0)GO TO 200
C RR8<0=CENTERED WHOLE REST - ASSUMES NO NEED TO JUSTIFY.
PR=3.0
IF(RL.GE.5.0)PR=PR+RR6*2.0
C RR6=DOTS
CC PL=1.0
GO TO 700
3 IF(RL.LT.3)GO TO 30
C <3 MEANS NOTHING IN R5
IF(RR5.GT.4)GO TO 200
C NOT A REAL CLEF IF >4 (0=TREB, 1=BASS, 2=ALT, 3=TEN, 4=PERC.)
30 IF(RL.GE.2.AND.RR4.GE.100.0)RY=.85
PR=6.5*RY
GO TO 700
4 IF(RL.GT.3.OR.RR4.LT.0)GO TO 200
C IF P4.LT.0 THEN IT'S AN INVISIBLE BAR.
CC FOR REPEAT BAR WDCNT IS 3 -- 10/77 444 IF(RL.GT.2)GO TO 2
C SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
PL=0.5
PR=1.
C PL=SPACE NEEDED TO LEFT, PR=SPACE NEEDED TO RIGHT, RR3=POS. OF ITEM
KX=RR4/1000.
IF(KX.LE.0.)GO TO 40
PL=3.2
C ADD A LITTLE SPACE IN FRONT OF DBL BAR.
IF(KX.EQ.2.OR.KX.EQ.4)PR=6.0
C KX=2=DOTS TO RIGHT
IF(KX.GT.2)PL=4.2
C KX>2=DOTS TO LEFT
CC IF(RL.LT.3)GO TO 700
C JUMP IF THIN DBL BAR. OLD DBL BAR HAS 1 IN R5.
CC229 IF(KX.NE.2)PR=PR+PR
C 2=DOTS TO RT. 1 OR 4=DOTS TO LFT. 3=DOTS ON BOTH SIDES.
C REPT BAR WITH DOTS TO LEFT. ADD SPACE IN FRONT OF IT.
CC PL=-PL/RBX
CC IF(KX.EQ.4)KX=0
CC129 IF(KX.GE.2)PL=RBZ*PL
C IF DOTS TO RIGHT ADD MORE SPACE AFTER REPT BAR.
GO TO 42
40 Z=999.
C FIND NEXT CLOSEST ITEM.
DO 41 M=1,ITEM
J=NPW(M)
IF(R2.LE.RJLP.AND.R2.NE.RN(J+2))GO TO 41
C SKIP IF NOT ON RIGHT STAFF
X=RN(J+3)
IF(X.GT.Z.OR.X.LE.RR3)GO TO 41
Z=RR3
L=J
C SAVE POS. AND CODE NUM.
41 CONTINUE
IF(RN(L+1).LE.2.0)PR=PR+1.5
C IF A NOTE OR REST, ADD 1.5 TO SPACE
42 RR4=AMOD(RR4,100.0)
C FIND HOW MANY STAVES UP THE BAR GOES
IF(RR4.EQ.0)RR4=1.0
RR4=RR4+RR2
43 CALL ROOM(RR3,PL,PR,RR2,R4,R5,RSTFAC)
C RR3=POS.,PL=NEED TO LEFT,PR=NEED TO RIGHT, RR2=STAFF#
RR2=RR2+1.0
C RESERVE SPACE FOR BAR LINE ON EVERY STAFF COVERED.
IF(RR2.LT.RR4)GO TO 43
GO TO 200
C KSIG
17 RR5=ABS(RR5)
IF(RR5.GE.100)RR5=RR5-100
C +100 FOR NATURALS AS KEYSIG.
PR=0.5+2.1*(RR5-1)
C SPACES FOR CORRECT NUM OF ACCIS. RR5=NUM OF ACCIS.
PL=3.0
GO TO 700
C METER
18 RC=0
IF(RL.GE.7)RC=9
C FOR COMPOSITE METERS. NO CHECK FOR DBL DIGITS YET.
PR=4.0
PL=1.5
IF(RR6.LE.9.AND.RR5.LE.9)GO TO 180
C CHECKS FOR 2-DIGIT METERS
PR=6.0
PL=2.5
180 PR=PR+RC
700 CALL ROOM(RR3,PL,PR,RR2,R4,R5,RSTFAC)
C RR3=POS.,PL=NEED TO LEFT,PR=NEED TO RIGHT, RR2=STAFF#
200 CONTINUE
CALL JSORT(NO,R2,R4,R5,RN)
300 END
SUBROUTINE ROOM(RB,RL,RR,STAF,R4,R5,RSTFAC)
C SETS UP ARRAYS CONTAINING ALL NEEDED SPACE INFO
COMMON /RINP/PS(900),PR(300)
COMMON /JST/ N,P(300),PL(300)
C SHARE THESE ARRAYS WITH SOME OTHERS??? (RINP?)
DIMENSION RSTFAC(0/1)
P(N)=0
PL(N)=0
PR(N)=0
PS(N)=-1
C ZERO OUT NEXT ARRAY SLOTS
IF(ABS(RB-R4).LE.0.1)RL=0
IF(ABS(RB-R5).LE.0.1)RR=0
CHECK TO SEE IF ITEM IS AT LEFT OR RIGHT EDGE OF JUSTIFY AREA.
K=STAF
S=RSTFAC(K)
C GET PROPER SIZE FACTOR FOR THIS STAFF
RL=RL*S
RR=RR*S
DO 1 K=1,N-1
IF(ABS(RB-P(K)).GT.0.1)GO TO 1
C SAME POSITION?
IF(RB.LT.P(K))P(K)=RB
C USE POSITION FARTHEST TO LEFT
IF(STAF.NE.PS(K))GO TO 1
C SAME STAFF?
IF(PR(K).LT.RR)PR(K)=RR
IF(PL(K).LT.RL)PL(K)=RL
C ITEM IN SAME POS. CHANGE SPACE REQUIREMENTS IF NECESSARY.
RETURN
1 CONTINUE
P(N)=RB
PR(N)=RR
PL(N)=RL
PS(N)=STAF
N=N+1
C PUT AWAY MORE SPACE NEEDS.
END
SUBROUTINE JSORT(NO,R2,R4,R5,RN)
DIMENSION NO(1),RN(1)
COMMON /RINP/PS(900),PR(300)
C PS HAS 900 SO THERE IS ROOM FOR "NO" ARRAY (CHANGE THIS LATER?)
COMMON /JST/ N,P(300),PL(300)
P(N)=R5
PR(N)=0
PL(N)=0
PS(N)=9999.
C LAST POINT IS RIGHT LIMIT OF JUSTIFY AREA
P(N+1)=9999.
CCC N=N-1
K=1
2 A=P(K)
M=K+1
KK=K
DO 1 L=M,N
B=ABS(P(L)-A)
IF(B.GT.0.1)GO TO 6
P(L)=A
C SAME POS.
GO TO 1
6 IF(P(L).GT.A)GO TO 1
C FIND ITEM FURTHEST TO LEFT
A=P(L)
K=L
1 CONTINUE
10 IF(K.EQ.KK)GO TO 3
B=PR(K)
C=PL(K)
D=PS(K)
DO 4 L=K,KK+1,-1
C SHUFFLE ARRAYS
LL=L-1
P(L)=P(LL)
PL(L)=PL(LL)
PR(L)=PR(LL)
4 PS(L)=PS(LL)
11 P(KK)=A
PR(KK)=B
PL(KK)=C
PS(KK)=D
3 K=KK+1
IF(K.LE.N)GO TO 2
C NOW COLLECT ALL SPACE IN PL ARRAY
DO 20 K=2,N+1
L=K-1
IF(PS(K).NE.PS(L))GO TO 21
C SAME STAFF?
GO TO 23
21 L=K-2
22 IF(PS(L).EQ.PS(K))GO TO 23
L=L-1
IF(L.GT.0)GO TO 22
GO TO 20
23 PL(K)=PL(K)+PR(L)
C FOUND PREVIOUS ITEM ON SAME STAFF.
20 CONTINUE
C NOW STORE POS OF EACH PREV. ITEM ON SAME STAFF IN PR ARRAY.
DO 40 K=2,N+1
L=K-1
IF(PS(K).NE.PS(L))GO TO 41
C SAME STAFF?
GO TO 43
41 L=K-2
42 IF(PS(L).EQ.PS(K))GO TO 43
L=L-1
IF(L.GT.0)GO TO 42
PR(K)=R4
C FAR LEFT POS. OF JUST. RANGE GOES INTO PS
GO TO 40
43 PR(K)=P(L)
C FOUND PREVIOUS ITEM ON SAME STAFF.
C STORE POS. OF PREVIOUS ITEM IN PR ARRAY.
40 CONTINUE
PR(1)=R4
C NOW GET RID OF UNNEEDED DATA
L=2
30 LL=L-1
IF(P(L).NE.P(LL))GO TO 36
C NOW 2 ITEMS IN SAME POS. ON DIFF. STAVES
IF(PR(L).EQ.PR(LL))GO TO 34
C JUMP IF POS. OF PREV. ITEM IS SAME IN BOTH CASES.
A=P(L)-PR(L)-PL(L)
B=P(LL)-PR(LL)-PL(LL)
C A,B = EXCESS SPACE AVAILABLE., KEEP THE ONE WITH THE LEAST.
IF(B.GT.A)L=L-1
GO TO 35
34 IF(PL(L).GT.PL(LL))PL(LL)=PL(L)
C EXCHANGE IF NEEDED SPACE HERE IS < PREVIOUS NEEDED
35 N=N-1
C DECREMENT COUNTER
33 DO 32 K=L,N
C CONTRACT ARRAY
M=K+1
PL(K)=PL(M)
PR(K)=PR(M)
32 P(K)=P(M)
GO TO 9
36 L=L+1
9 IF(L.LE.N)GO TO 30
100 DO 101 K=1,N
101 PS(K)=P(K)
C PS WILL HOLD SHIFTED POINTS
99 FORMAT('+',I2,1X,$)
98 FORMAT(' ',$)
TYPE 98
DO 50 J=1,40
C "ACCORDEAN" LOOP - USUALLY EXITS WELL BEFORE 40
Y=0
TYPE 99,J
DO 51 K=2,N
A=PS(K)-PR(K)-PL(K)
C NEG. MOVE REQUIREMENT
IF(A.GE.-0.1)GO TO 51
C SKIP IF ENOUGH SPACE
Y=PS(K)
C SHIFT ALL POINTS FOUND FROM HERE TO FAR RIGHT
DO 52 L=K,N
PS(L)=PS(L)-A
52 IF(PR(L).GE.Y)PR(L)=PR(L)-A
IF(PR(K).EQ.PS(K-1))GO TO 51
C JUMP IF PREVIOUS ITEM ON SAME STAFF
C NOW SHIFT OTHER STAVES' ITEMS FOUND TO LEFT
Z=PR(K)
C LOOK IN AREA BOUNDED BY Z AND Y
F=(Y-Z-A)/(Y-Z)
C SPACING FACTOR
DO 53 L=1,N
B=PS(L)
IF(B.LT.Z.OR.B.GT.Y)GO TO 54
C FOUND A POINT TO SHIFT
B=B-Z
C ACTUAL SPACE FROM LEFT LIMIT
PS(L)=Z+B*F
C LEFT LIMIT+SPACE*FACTOR
54 B=PR(L)
IF(B.LT.Z.OR.B.GT.Y)GO TO 53
B=B-Z
PR(L)=Z+B*F
53 CONTINUE
51 CONTINUE
IF(PS(N).LE.R5)GO TO 203
C MORE THAN ENOUGH SPACE EXISTS
IF(Y.EQ.0)GO TO 203
C JUMP OUT IF NO POINTS MOVED
F=(R5-R4)/(PS(N)-R4)
C FACTOR TO SHIFT ALL BACK WITHIN ORIGINAL LIMITS
DO 56 K=1,N
PS(K)=R4+(PS(K)-R4)*F
56 PR(K)=R4+(PR(K)-R4)*F
50 CONTINUE
C NOW PS(1) SHOULD BE >=R4, PS(N)<=R5.
203 CALL MOVIT(RN,NO,R5,2000.0,1000.0,0.0)
C MOVE ANYTHING TO RIGHT OF JUSTIFY AREA FAR TO RIGHT.
CC CAN'T USE DO LOOP, FAIL PROG. WIPES OUT AC15. DO 206 K=1,N
CALL MOVIT(RN,NO,R4,R5,500.0,0.0)
C NOW MOVE JUSTIFY AREA 500 TO RIGHT. LEAVES ROOM FOR EXPANSION, CONTRACTION.
K=2
L=1
C A= AMOUNT MOVED LEFT OR RIGHT.
206 CALL MOVIT(RN,NO,P(L)+500.0,P(K)+500.0,PS(L),PS(K))
C MOVE OLD RANGE INTO NEW RANGE (AND SHIFT BACK 500)
L=K
K=K+1
IF(K.LE.N)GO TO 206
CALL MOVIT(RN,NO,R5+1000.0,3000.0,-1000.0,0.0)
C MOVE BACK THINGS TO RIGHT OF JUSTIFY AREA. NOW ALL DONE.
300 END